home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Pascal / Libraries / DBL Pascal Library / Queues / Queue < prev   
Encoding:
Text File  |  1993-03-29  |  2.4 KB  |  117 lines  |  [TEXT/PJMM]
  1. unit Queue;
  2.  
  3. {This implements a double-ended queue with a fixed size limit.}
  4.  
  5. interface
  6.  
  7.     type
  8.         Queue = record
  9.                 Qhead, Qtail, Qsize: Integer;
  10.                 Qelts: array[0..0] of Longint;    {allow one empty element as a sentinel}
  11.             end;
  12.         QueuePtr = ^Queue;
  13.         QueueHandle = ^QueuePtr;
  14.  
  15.     procedure NewQueue (itsSize: Integer;
  16.                                     var theQueue: QueueHandle);
  17.     procedure DisposeQueue (theQueue: QueueHandle);
  18.     procedure FlushQueue (theQueue: QueueHandle);
  19.  
  20.     function QueueFull (theQueue: QueueHandle): Boolean;
  21.     function QueueEmpty (theQueue: QueueHandle): Boolean;
  22.  
  23.     procedure EnqueueHead (item: univ Longint;
  24.                                     theQueue: QueueHandle);
  25.     procedure EnqueueTail (item: univ Longint;
  26.                                     theQueue: QueueHandle);
  27.     procedure DequeueHead (var item: univ Longint;
  28.                                     theQueue: QueueHandle);
  29.  
  30. implementation
  31.  
  32.     procedure FlushQueue (theQueue: QueueHandle);
  33.     begin
  34.         with theQueue^^ do
  35.             begin
  36.                 Qhead := 0;
  37.                 Qtail := 0;
  38.             end;
  39.     end;
  40.  
  41.     procedure NewQueue (itsSize: Integer;
  42.                                     var theQueue: QueueHandle);
  43.     begin
  44.         theQueue := QueueHandle(NewHandle(SIZEOF(Queue) + itsSize * SIZEOF(Longint)));    {this leaves a sentinel}
  45.         theQueue^^.Qsize := itsSize;
  46.         FlushQueue(theQueue);
  47.     end;
  48.  
  49.     procedure DisposeQueue (theQueue: QueueHandle);
  50.     begin
  51.         DisposHandle(Handle(theQueue));
  52.     end;
  53.  
  54.     function QueueFull (theQueue: QueueHandle): Boolean;
  55.     begin
  56.         with theQueue^^ do
  57.             QueueFull := ((Qhead = Qsize) & (Qtail = 0)) | ((Qhead + 1) = Qtail);
  58.     end;
  59.  
  60.     function QueueEmpty (theQueue: QueueHandle): Boolean;
  61.     begin
  62.         with theQueue^^ do
  63.             QueueEmpty := Qhead = Qtail;
  64.     end;
  65.  
  66.     procedure EnqueueHead (item: univ Longint;
  67.                                     theQueue: QueueHandle);
  68.     begin
  69.         with theQueue^^ do
  70.             if not QueueFull(theQueue) then
  71.                 begin
  72. {$PUSH}
  73. {$R-}
  74.                     Qelts[Qhead] := item;
  75. {$POP}
  76.                     if Qhead = Qsize then
  77.                         Qhead := 0
  78.                     else
  79.                         Qhead := Qhead + 1;
  80.                 end;
  81.     end;
  82.  
  83.     procedure EnqueueTail (item: univ Longint;
  84.                                     theQueue: QueueHandle);
  85.     begin
  86.         with theQueue^^ do
  87.             if not QueueFull(theQueue) then
  88.                 begin
  89.                     if Qtail = 0 then
  90.                         Qtail := Qsize
  91.                     else
  92.                         Qtail := Qtail - 1;
  93. {$PUSH}
  94. {$R-}
  95.                     Qelts[Qtail] := item;
  96. {$POP}
  97.                 end;
  98.     end;
  99.  
  100.     procedure DequeueHead (var item: univ Longint;
  101.                                     theQueue: QueueHandle);
  102.     begin
  103.         with theQueue^^ do
  104.             if not QueueEmpty(theQueue) then
  105.                 begin
  106.                     if Qhead = 0 then
  107.                         Qhead := Qsize
  108.                     else
  109.                         Qhead := Qhead - 1;
  110. {$PUSH}
  111. {$R-}
  112.                     item := Qelts[Qhead];
  113. {$POP}
  114.                 end;
  115.     end;
  116.  
  117. end.